VERSION 5.00
Begin VB.MDIForm Oversea 
   BackColor       =   &H8000000C&
   Caption         =   "Oversea Management"
   ClientHeight    =   7110
   ClientLeft      =   165
   ClientTop       =   855
   ClientWidth     =   8970
   Icon            =   "Oversea.frx":0000
   LinkTopic       =   "MDIForm1"
   StartUpPosition =   3  'Windows Default
   WindowState     =   2  'Maximized
   Begin VB.Menu cs 
      Caption         =   "Customer Service"
      Begin VB.Menu cs_find 
         Caption         =   "Find a customer"
      End
      Begin VB.Menu cs_add 
         Caption         =   "Add a customers"
      End
      Begin VB.Menu cs_complete 
         Caption         =   "Check customers"
      End
      Begin VB.Menu cs_complaint 
         Caption         =   "Make a complaint"
      End
      Begin VB.Menu cs_report 
         Caption         =   "Bug management"
      End
      Begin VB.Menu OH 
         Caption         =   "Operation History"
      End
   End
   Begin VB.Menu Data 
      Caption         =   "Data"
      Begin VB.Menu CheckTNumber 
         Caption         =   "Format Telephone and Fax Number"
      End
      Begin VB.Menu DeluselessData 
         Caption         =   "Delete useless data"
      End
      Begin VB.Menu formaturl 
         Caption         =   "Format URLs"
      End
      Begin VB.Menu formataddress 
         Caption         =   "Format Address"
      End
      Begin VB.Menu findRedundant 
         Caption         =   "Find useless data(NO CLASSIFICATION)"
      End
      Begin VB.Menu Backup 
         Caption         =   "Backup"
      End
      Begin VB.Menu SeekID 
         Caption         =   "Seek ID"
      End
      Begin VB.Menu delsamename 
         Caption         =   "Delete users with the same name"
      End
      Begin VB.Menu dans 
         Caption         =   "Delete a news"
      End
      Begin VB.Menu das 
         Caption         =   "Delete an Share"
      End
      Begin VB.Menu da 
         Caption         =   "Delete an article"
      End
      Begin VB.Menu dab 
         Caption         =   "Delete a blog"
      End
      Begin VB.Menu deletern 
         Caption         =   "Delete rn"
      End
      Begin VB.Menu daq 
         Caption         =   "Delete a query"
      End
      Begin VB.Menu dnonusr 
         Caption         =   "Delete a non-normal user"
      End
      Begin VB.Menu dnusr 
         Caption         =   "Delete a normal Usr"
      End
      Begin VB.Menu lfrd 
         Caption         =   "Looking for Redundant data"
      End
      Begin VB.Menu webGuideCollection 
         Caption         =   "Web guide collection"
      End
      Begin VB.Menu RunSQL 
         Caption         =   "Run a SQL"
      End
      Begin VB.Menu showstatus 
         Caption         =   "Show status"
      End
      Begin VB.Menu DelMappingTable 
         Caption         =   "Del mapping table"
      End
      Begin VB.Menu Delclassification 
         Caption         =   "Del redundent classification"
      End
      Begin VB.Menu ReplaceFlag 
         Caption         =   "ReplaceFlag"
      End
   End
   Begin VB.Menu cs_hr 
      Caption         =   "HR"
      Begin VB.Menu cs_staff 
         Caption         =   "Staff"
      End
      Begin VB.Menu cs_resume 
         Caption         =   "Resume"
      End
      Begin VB.Menu cs_vacancy 
         Caption         =   "Vacancy"
      End
      Begin VB.Menu WS 
         Caption         =   "Working Sheet"
      End
   End
   Begin VB.Menu cs_finance 
      Caption         =   "Finance"
      Begin VB.Menu cs_cost 
         Caption         =   "Cost"
      End
   End
   Begin VB.Menu cs_marketing 
      Caption         =   "Marketing"
      Begin VB.Menu cs_datayellowpage 
         Caption         =   "Get data from yellow page"
      End
      Begin VB.Menu AddFooter 
         Caption         =   "Add Footer"
      End
      Begin VB.Menu ReadExcel 
         Caption         =   "Read Excel"
      End
      Begin VB.Menu webGuide 
         Caption         =   "Website guide"
      End
      Begin VB.Menu WebSpider 
         Caption         =   "Web guide spider"
      End
      Begin VB.Menu SiteMap 
         Caption         =   "SiteMap Generator"
      End
   End
   Begin VB.Menu M 
      Caption         =   "Management"
      Begin VB.Menu Newsmanager 
         Caption         =   "News Management"
      End
      Begin VB.Menu cs_info 
         Caption         =   "Infomation management"
      End
   End
   Begin VB.Menu about 
      Caption         =   "About"
      Begin VB.Menu Regards 
         Caption         =   "About Oversea.com.au"
      End
      Begin VB.Menu version 
         Caption         =   "Version"
      End
      Begin VB.Menu newversion 
         Caption         =   "Latest version"
      End
      Begin VB.Menu Download 
         Caption         =   "Download latest"
      End
      Begin VB.Menu AddNewV 
         Caption         =   "Add a new version"
      End
   End
End
Attribute VB_Name = "Oversea"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim MDIRs As New ADODB.Recordset
Dim MDICn As New ADODB.Connection
Dim bCompulsive As Boolean
Private Sub AddFooter_Click()
    frmSplash.Show
    DoEvents
    frmFooter.Show
    DoEvents
    Unload frmSplash
End Sub

Private Sub AddNews_Click()
    frmNews.Show
End Sub

Private Sub AddNewV_Click()
    Dialog.Show
End Sub


'fix tel number and save it to database
Private Sub UpdateTelToSql(ByVal tel As String, ByVal id As Long, ByVal cn As ADODB.Connection)
    Dim i, iLen As Integer
    Dim ch
    Dim newStr As String
    Dim TidyStr As String
    Dim rs As New ADODB.Recordset
    Dim sql As String
    
    iLen = Len(tel)
    'the shortest length in Australia is 3, such as 120, 000
    If Len(Trim(tel)) < 3 Then
        Exit Sub
    End If
    
    'get rid of all illegal characters
    newStr = ""
    
    For i = 1 To iLen
        ch = Mid(tel, i, 1)
        If ch <= "9" And ch >= "0" Then
            newStr = newStr & ch
        End If
    Next i
    
    If Len(newStr) < 3 Then
        Exit Sub
    End If
    
    'if the first digit is '+', delete first 3 digits then plus 0
    If Mid(newStr, 1, 1) = "+" Then
        newStr = "0" & Mid(newStr, 4, Len(newStr) - 3)
    End If
    'if length is 10, it is a mobile, change to 0413 097 370
    TidyStr = newStr
    If Len(newStr) = 10 Then
        TidyStr = Mid(newStr, 1, 4) & " " & Mid(newStr, 5, 3) & " " & Mid(newStr, 8, 3)
    End If
    'if length is 8, it is a land line phone 08 1234 5678
    If Len(newStr) = 8 Then
        TidyStr = "(" & Mid(newStr, 1, 2) & ")" & Mid(newStr, 3, 4) & " " & Mid(newStr, 7, 4)
    End If
    'all other lengths, do nothing
    '------------------------------
    frmSplash.lblStatus.Caption = "Updating ID: " & id
    DoEvents
    'Save this number to database
    sql = "UPDATE `org_firststep` set `tel`='" & TidyStr & "' WHERE temp_userid=" & id
    Call CloseRecordSet(rs)
    OperateDatabase rs, cn, sql
    
    'rs.Close
End Sub

Private Sub Backup_Click()
   frmSplash.Show
   DoEvents
   frmBackup.Show
   DoEvents
   Unload frmSplash
End Sub

Private Sub business_spread_Click()
    'business spread for each city
    'frmBS.Show
End Sub

Private Sub CheckTNumber_Click()
    Dim rs As New ADODB.Recordset
    Dim cn As New ADODB.Connection
    
    Dim sql As String
    Dim StartId As Integer
    
    StartId = 1
    
    Call Cn2Oversea(cn)
    'Change all the telephone number format to (0*)1234 5678
    If vbOK = MsgBox("All telephone numbers and fax number to Compass Technology standard?", vbOKCancel, SOFT_TITLE) Then
        'scan org_firststep table --tel
        frmSplash.Show
        DoEvents
        frmSplash.lblStatus.Caption = "Checking Fax..."
        DoEvents
        'fax
        sql = "SELECT `temp_userid`, `fax` FROM `org_details` WHERE length(`fax`)>0 order by `temp_userid` ASC"
        Call CloseRecordSet(rs)
        OperateDatabase rs, cn, sql
        While Not rs.EOF
            UpdateTelToSql rs.Fields(1).value, rs.Fields(0).value, cn
            rs.MoveNext
        Wend
        
        'phone in org_firststep
        sql = "SELECT `temp_userid`, `tel` FROM `org_firststep` WHERE `temp_userid` >" & StartId & " and length(`tel`)>0 order by `temp_userid` ASC"
        Call CloseRecordSet(rs)
        OperateDatabase rs, cn, sql
    
        While Not rs.EOF
            UpdateTelToSql rs.Fields(1).value, rs.Fields(0).value, cn
            rs.MoveNext
        Wend
        'MsgBox "Table org_firststep was done!", vbOKOnly, SOFT_TITLE
    
        'phone in org_details
        sql = "SELECT `temp_userid`, `usr_phone` FROM `org_details` WHERE `temp_userid` >" & StartId & " and length(`usr_phone`)>0 order by `temp_userid` ASC"
        Call CloseRecordSet(rs)
        OperateDatabase rs, cn, sql
    
        While Not rs.EOF
            UpdateTelToSql rs.Fields(1).value, rs.Fields(0).value, cn
            rs.MoveNext
        Wend
        
        DoEvents
        Unload frmSplash
    End If
    rs.Close
    cn.Close
    
End Sub

Private Sub cs_add_Click()
CustomerType = NEW_CUSTOMER
Unload customer
customer.Show
End Sub

Private Sub cs_complete_Click()
CustomerType = CHECK_DATA
frmCheckCustomers.Show
'Unload customer
'customer.Show
End Sub


Private Sub cs_datayellowpage_Click()
    frmInputURL.Show
End Sub

'get data from one classfication
Private Sub cs_getOneClassification()
    
End Sub

Private Sub cs_find_Click()
CustomerType = FIND_CUSTOMER
Unload customer
customer.Show
End Sub

Private Sub cs_info_Click()
    frmShare.Show
End Sub

Private Sub cs_report_Click()
    BugSystem.Show
End Sub

Private Sub cs_staff_Click()
    'add a new operator
    frmAddOperators.Show
End Sub

Private Sub da_Click()
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim news_id
    
    Call Cn2Oversea(cn)
    news_id = InputBox("Please input the id of this article", SOFT_TITLE)
    If news_id <> "" Then
        Delete_an_article news_id, cn, rs
        MsgBox "All done!", vbOKOnly, SOFT_TITLE
    End If
    
    cn.Close
End Sub

Private Sub dab_Click()
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim news_id
    
    Call Cn2Oversea(cn)
    news_id = InputBox("Please input the id of this blog", SOFT_TITLE)
    If news_id <> "" Then
        Delete_a_personal_blog news_id, cn, rs
        MsgBox "All done!", vbOKOnly, SOFT_TITLE
    End If
    
    cn.Close
End Sub

Private Sub dans_Click()
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim news_id
    
    Call Cn2Oversea(cn)
    news_id = InputBox("Please input the id of this news", SOFT_TITLE)
    If news_id <> "" Then
        Delete_a_news news_id, cn, rs
        MsgBox "All done!", vbOKOnly, SOFT_TITLE
    End If
    
    cn.Close
End Sub

Private Sub daq_Click()
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim news_id
    
    Call Cn2Oversea(cn)
    news_id = InputBox("Please input the id of this query", SOFT_TITLE)
    If news_id <> "" Then
        Delete_a_Query news_id, cn, rs
        MsgBox "All done!", vbOKOnly, SOFT_TITLE
    End If
    
    cn.Close
End Sub

Private Sub das_Click()
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim news_id
    
    Call Cn2Oversea(cn)
    news_id = InputBox("Please input the id of this post", SOFT_TITLE)
    If news_id <> "" Then
        Delete_a_Share news_id, cn, rs
        MsgBox "All done!", vbOKOnly, SOFT_TITLE
    End If
    
    cn.Close
End Sub

Private Sub Delclassification_Click()
    ' delete cs mapping table redundent data
    Dim sql As String
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim rsdel As New ADODB.Recordset
    
    Call Cn2Oversea(cn)
    frmSplash.Show
    frmSplash.lblStatus.Caption = "Connecting to cs_classification table..."
    DoEvents
    sql = "SELECT temp_userid FROM cs_classification"
    Call CloseRecordSet(rs)
    OperateDatabase rs, cn, sql
    
    While Not rs.EOF
        Dim bIsRecord As Boolean
        Dim id As String
        bIsRecord = False
        
        id = rs.Fields(0).value
        If 1 Then
            sql = "SELECT temp_userid FROM usr_details WHERE temp_userid = '" & id & "' limit 0,1 "
            Call CloseRecordSet(rsdel)
            OperateDatabase rsdel, cn, sql
            frmSplash.lblStatus.Caption = "Checking ID : " & id
            DoEvents
            While Not rsdel.EOF
                bIsRecord = True
                rsdel.MoveNext
            Wend
            If bIsRecord = False Then
                sql = "DELETE FROM cs_classification WHERE temp_userid='" & id & "'"
                Call CloseRecordSet(rsdel)
                OperateDatabase rsdel, cn, sql
            End If
        End If
        rs.MoveNext
    Wend
    
    DoEvents
    Unload frmSplash
    MsgBox "All done!", vbOKOnly, SOFT_TITLE
    rs.Close
    'rsDel.Close
    cn.Close
End Sub

Private Sub deletern_Click()
    'change rn
    Dim sql As String
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim rsInsert As New ADODB.Recordset
    Call Cn2Oversea(cn)
    On Error Resume Next
    sql = "SET NAMES gbk"
    OperateDatabase rs, cn, sql

    
    frmSplash.Show
    DoEvents
    
    sql = "SELECT content, id from 2012_feeds  WHERE id<=49 order by id DESC"
    Call CloseRecordSet(rs)
    OperateDatabase rs, cn, sql
    
    While Not rs.EOF
        Dim c As String
        c = replaceRN(rs.Fields(0).value)
        sql = "update 2012_feeds set content='" & (c) & "' WHERE id='" & rs.Fields(1).value & "'"
        Debug.Print sql
        frmSplash.lblStatus.Caption = "ID is " & rs.Fields(1).value
        DoEvents
        Call CloseRecordSet(rsInsert)
        OperateDatabase rsInsert, cn, sql
        rs.MoveNext
    Wend
    
    
    
    
    Unload frmSplash
    cn.Close
End Sub

Private Function replaceRN(ByRef content As String)
    replaceRN = Replace(content, "\r\n", " ")
End Function






Private Sub DelMappingTable_Click()
    ' delete cs mapping table redundent data
    Dim sql As String
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim rsdel As New ADODB.Recordset
    
    Call Cn2Oversea(cn)
    frmSplash.Show
    frmSplash.lblStatus.Caption = "Connecting to cs_membname_mapping table..."
    DoEvents
    sql = "SELECT usr_id FROM cs_membname_mapping"
    Call CloseRecordSet(rs)
    OperateDatabase rs, cn, sql
    
    While Not rs.EOF
        Dim bIsRecord As Boolean
        Dim id As String
        bIsRecord = False
        
        id = rs.Fields(0).value
        If Mid(id, 2, 1) = "0" And Mid(id, 3, 1) = "0" Then
            sql = "SELECT usr_id FROM usr_details WHERE usr_id = '" & id & "' limit 0,1 "
            Debug.Print sql
            Call CloseRecordSet(rsdel)
            OperateDatabase rsdel, cn, sql
            frmSplash.lblStatus.Caption = "Checking ID : " & id
            DoEvents
            While Not rsdel.EOF
                bIsRecord = True
                rsdel.MoveNext
            Wend
            If bIsRecord = False Then
                sql = "DELETE FROM cs_membname_mapping WHERE usr_id='" & id & "'"
                Call CloseRecordSet(rsdel)
                OperateDatabase rsdel, cn, sql
            End If
        Else
            sql = "SELECT usr_id FROM org_details WHERE usr_id = '" & id & "' limit 0,1 "
            Call CloseRecordSet(rsdel)
            OperateDatabase rsdel, cn, sql
            frmSplash.lblStatus.Caption = "Delete ID : " & id
            DoEvents
            While Not rsdel.EOF
                bIsRecord = True
                rsdel.MoveNext
            Wend
            
            If bIsRecord = False Then
                sql = "DELETE FROM cs_membname_mapping WHERE usr_id='" & id & "'"
                Call CloseRecordSet(rsdel)
                OperateDatabase rsdel, cn, sql
            End If
        End If
        rs.MoveNext
    Wend
    
    DoEvents
    Unload frmSplash
    MsgBox "All done!", vbOKOnly, SOFT_TITLE
    rs.Close
    'rsDel.Close
    cn.Close
End Sub

Private Sub DeluselessData_Click()
    'delete useless data
    'rules:
    '1. Must have business name
    '2. one of Address, tel, website, email
    '-----------------------------------
    Dim sql As String
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim rsdel As New ADODB.Recordset
    
    Call Cn2Oversea(cn)
    frmSplash.Show
    DoEvents
    
    sql = "SELECT `temp_userid` from org_details WHERE length(ltrim(`usr_shw_name`))=0 order by `temp_userid` ASC"
    Call CloseRecordSet(rs)
    OperateDatabase rs, cn, sql
    While Not rs.EOF
        frmSplash.lblStatus.Caption = "Deleting ID: " & rs.Fields(0).value
        DoEvents
        sql = "DELETE FROM `org_details` WHERE `temp_userid`=" & rs.Fields(0).value
        Call CloseRecordSet(rsdel)
        OperateDatabase rsdel, cn, sql
        sql = "DELETE FROM `org_firststep` WHERE `temp_userid`=" & rs.Fields(0).value
        Call CloseRecordSet(rsdel)
        OperateDatabase rsdel, cn, sql
        rs.MoveNext
    Wend
    
    sql = "SELECT `temp_userid` from org_details WHERE length(ltrim(`curr_addr`))+length(ltrim(`website`))+length(ltrim(`usr_phone`))=0 order by `temp_userid` ASC"
    Call CloseRecordSet(rs)
    OperateDatabase rs, cn, sql
    While Not rs.EOF
        frmSplash.lblStatus.Caption = "Deleting ID: " & rs.Fields(0).value
        DoEvents
        sql = "DELETE FROM `org_details` WHERE `temp_userid`=" & rs.Fields(0).value
        Call CloseRecordSet(rsdel)
        OperateDatabase rsdel, cn, sql
        sql = "DELETE FROM `org_firststep` WHERE `temp_userid`=" & rs.Fields(0).value
        Call CloseRecordSet(rsdel)
        OperateDatabase rsdel, cn, sql
        rs.MoveNext
    Wend
    
    DoEvents
    Unload frmSplash
    MsgBox "All done!", vbOKOnly, SOFT_TITLE
    rs.Close
    'rsDel.Close
    cn.Close
    
End Sub

Private Sub dnonusr_Click()
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim usr_id
    
    Call Cn2Oversea(cn)
    usr_id = InputBox("Please input the full id of a normal user", SOFT_TITLE)
    If usr_id <> "" Then
        Delete_a_non_normal_usr usr_id, cn, rs
        MsgBox "All done!", vbOKOnly, SOFT_TITLE
    End If
    
    cn.Close
End Sub

Private Sub dnusr_Click()
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim usr_id
    
    Call Cn2Oversea(cn)
    usr_id = InputBox("Please input the full id of a normal user", SOFT_TITLE)
    If usr_id <> "" Then
        Delete_a_normal_usr usr_id, cn, rs
        MsgBox "All done!", vbOKOnly, SOFT_TITLE
    End If
    
    cn.Close
End Sub

Private Sub Download_Click()
    'get the latest version
    Dim LVer As Long
    LVer = CheckVer()
    DownLoadFile "http://www.compass-uat.com", "/CSTools/Oversea-" & LVer & ".rar", "./Oversea.rar", "u116722", "hCNWKGcQ"
End Sub

Private Sub formataddress_click()
    If vbOK = MsgBox("Format all addresses to the standard mode?", vbOKCancel, SOFT_TITLE) Then
        formataddress1_Click 1
        formataddress1_Click 2
        MsgBox "All Done!", vbOKOnly, SOFT_TITLE
    End If
End Sub

Private Sub formataddress1_Click(ByVal iType As Integer)
    'format all address. Rules:
    '1. plus a space after ','
    '2. plus a space between digit and english letter
    Dim sql As String
    Dim rs As New ADODB.Recordset
    Dim rsdel As New ADODB.Recordset
    Dim cn As New ADODB.Connection
    Dim addr, tmpAddr, tmpDigit As String
    Dim i, iLen As Integer
    Dim bIsNumber, bIsLetter As Boolean
    
    bIsNumber = False
    
    Call Cn2Oversea(cn)
    'Change all the telephone number format to (0*)1234 5678
    If 1 Then
        frmSplash.Show
        DoEvents
        frmSplash.lblStatus.Caption = "Connecting to database..."
        DoEvents
        If iType = 1 Then
        sql = "SELECT `temp_userid`, `curr_add` from `org_firststep` WHERE length(ltrim(`curr_add`))>0 order by `temp_userid` ASC"
        Else
        sql = "SELECT `temp_userid`, `curr_addr` from `org_details` WHERE length(ltrim(`curr_addr`))>0 order by `temp_userid` ASC"
        End If
        Call CloseRecordSet(rs)
        OperateDatabase rs, cn, sql
        
        frmSplash.lblStatus.Caption = "Formating Address..."
        DoEvents
        While Not rs.EOF
            frmSplash.lblStatus.Caption = "Formating Address for business ID: " & rs.Fields(0).value
            DoEvents
            addr = Trim(rs.Fields(1).value)
            iLen = Len(addr)
            tmpAddr = ""
            For i = 1 To iLen
                tmpDigit = Mid(addr, i, 1)
                'add a space after ','
                If tmpDigit = "," Then
                    If i < iLen And Mid(addr, i + 1, 1) <> " " Then
                        tmpAddr = tmpAddr & tmpDigit & " "
                    Else
                        tmpAddr = tmpAddr & tmpDigit
                    End If
                'add a space between number and letter
                ElseIf IsLetter(tmpDigit) Then
                    If bIsNumber Then
                        If i < iLen And Mid(addr, i + 1, 1) <> " " Then
                            tmpAddr = tmpAddr & " " & tmpDigit
                        Else
                            tmpAddr = tmpAddr & tmpDigit
                        End If
                    Else
                        tmpAddr = tmpAddr & tmpDigit
                    End If
                'add a space between letter and number
                ElseIf IsNumber(tmpDigit) Then
                    If bIsLetter Then
                        If i < iLen And Mid(addr, i + 1, 1) <> "" Then
                            tmpAddr = tmpAddr & " " & tmpDigit
                        Else
                            tmpAddr = tmpAddr & tmpDigit
                        End If
                    Else
                        tmpAddr = tmpAddr & tmpDigit
                    End If
                Else
                    tmpAddr = tmpAddr & tmpDigit
                End If
                bIsNumber = IsNumber(tmpDigit)
                bIsLetter = IsLetter(tmpDigit)
            Next i
            addr = tmpAddr
            'save the changed data back database
            If iType = 1 Then
            sql = "UPDATE `org_firststep` SET `curr_add`='" & AddSlashes(addr) & "' WHERE temp_userid=" & rs.Fields(0).value
            Else
            sql = "UPDATE `org_details` SET `curr_addr`='" & AddSlashes(addr) & "' WHERE temp_userid=" & rs.Fields(0).value
            End If
            Call CloseRecordSet(rsdel)
            OperateDatabase rsdel, cn, sql
            
            rs.MoveNext
        Wend
        DoEvents
        Unload frmSplash
        Call CloseRecordSet(rsdel)
        Call CloseRecordSet(rs)
        cn.Close
    End If
End Sub

Private Function IsNumber(ByVal str As String) As Boolean
    If str > "9" Or str < "0" Then
        IsNumber = False
    Else
        IsNumber = True
    End If
End Function

Private Function IsLetter(ByVal str As String) As Boolean
    If LCase(str) > "z" Or LCase(str) < "a" Then
        IsLetter = False
    Else
        IsLetter = True
    End If
End Function

Private Sub formaturl_Click()
    'format URL rules:
    '1. all http://abc.com -> abc.com
    '2. all https://abc.com -> https://abc.com
    '3. all http:abc.com -> abc.com
    '4. all ftp://abc.com -> ftp://abc.com
    Dim sql As String
    Dim rs As New ADODB.Recordset
    Dim rsdel As New ADODB.Recordset
    Dim cn As New ADODB.Connection
    Dim URL, tmpUrl As String
    Call Cn2Oversea(cn)
    'Change all the telephone number format to (0*)1234 5678
    If vbOK = MsgBox("Format all urls to the standard mode?", vbOKCancel, SOFT_TITLE) Then
        sql = "SELECT `temp_userid`, `website` from `org_details` WHERE length(ltrim(`website`))>0 order by `temp_userid` ASC"
        Call CloseRecordSet(rs)
        OperateDatabase rs, cn, sql
        frmSplash.Show
        frmSplash.lblStatus.Caption = "Formating URLs..."
        DoEvents

        While Not rs.EOF
            frmSplash.lblStatus.Caption = "Formating URL for business ID: " & rs.Fields(0).value
            DoEvents
            URL = Trim(rs.Fields(1).value)
            'if the url is too short, just delete it
            If Len(URL) >= 4 Then
                If InStr(LCase(URL), "http://") > 0 Then
                    tmpUrl = Mid(URL, 8, Len(URL) - 7)
                    URL = tmpUrl
                Else
                    If InStr(LCase(URL), "http:") > 0 Then
                        tmpUrl = Mid(URL, 6, Len(URL) - 6)
                        URL = tmpUrl
                    End If
                End If
            Else
                URL = ""
            End If
            'update the data back database
            sql = "UPDATE `org_details` SET `website`='" & URL & "' WHERE `temp_userid`=" & rs.Fields(0).value
            Call CloseRecordSet(rsdel)
            OperateDatabase rsdel, cn, sql
            rs.MoveNext
        Wend
        DoEvents
        Unload frmSplash
        MsgBox "All done!", vbOKOnly, SOFT_TITLE
    End If
    rs.Close
    cn.Close
End Sub
Private Sub delsamename_Click()
    Dim sql As String
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim rsRed As New ADODB.Recordset
    Dim rsdel As New ADODB.Recordset
    Dim sqldel As String
    frmSplash.Show
    DoEvents
    Call Cn2Oversea(cn)
On Error GoTo Keepon
     sql = "SET NAMES gbk"
    Call CloseRecordSet(rs)
    OperateDatabase rs, cn, sql
Keepon:
    frmSplash.lblStatus.Caption = "Analytising data..."
    DoEvents
    
    sql = "SELECT count(*) as rn, temp_userid, `org_name` FROM `org_firststep` where city_id=5 group by `org_name` "
    Call CloseRecordSet(rs)
    OperateDatabase rs, cn, sql
    
    While Not rs.EOF
        If rs.Fields(0).value > 1 Then
            sql = "SELECT temp_userid FROM `org_firststep` WHERE `org_name`='" & AddSlashes(rs.Fields(2).value) & "'"
            Call CloseRecordSet(rsRed)
            OperateDatabase rsRed, cn, sql
            'keep the first record
            rsRed.MoveNext
            While Not rsRed.EOF
                frmSplash.lblStatus.Caption = "deleting data which id is : " & rsRed.Fields(0).value
                DoEvents
                sqldel = "DELETE FROM `org_firststep` WHERE temp_userid ='" & rsRed.Fields(0).value & "'"
                DeleteRData sqldel
                 Call CloseRecordSet(rsdel)
                OperateDatabase rsdel, cn, sqldel
                sqldel = "DELETE FROM `org_details` WHERE temp_userid ='" & rsRed.Fields(0).value & "'"
                DeleteRData sqldel
                 Call CloseRecordSet(rsdel)
                OperateDatabase rsdel, cn, sqldel
                
                rsRed.MoveNext
            Wend
        End If
        rs.MoveNext
    Wend
    
    Unload frmSplash
    DoEvents
    MsgBox "all done!", vbOKOnly, SOFT_TITLE
    rs.Close
    cn.Close
    
End Sub


Private Sub lfrd_Click()
    'start from org_details then org_firststep
    Dim sql As String
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset, rsInsert As New ADODB.Recordset
    Dim o_usr_shw_name
    Dim o_usr_mails
    Dim o_usr_phone
    Dim o_city_id
    Dim o_curr_addr
    Dim o_full_id
    Dim i As Integer
    
    i = 0
    
    frmSplash.Show
    frmSplash.lblStatus.Caption = "connecting..."
    DoEvents
    
    Call Cn2Oversea(cn)
    sql = "SET NAMES gbk"
    Call CloseRecordSet(rs)
    OperateDatabase rs, cn, sql
    GoTo AnotherCheck
    
    
    sql = "SELECT * FROM `org_firststep` WHERE temp_userid not in (SELECT temp_userid FROM `org_details`) "
    Call CloseRecordSet(rs)
    OperateDatabase rs, cn, sql
    While Not rs.EOF
        Dim bExist As Boolean
        
        bExist = False
        
        i = i + 1
        o_usr_shw_name = rs.Fields(1).value
        o_usr_mails = rs.Fields(2).value
        o_usr_phone = rs.Fields(3).value
        o_city_id = rs.Fields(6).value
        o_curr_addr = rs.Fields(7).value
        o_full_id = "1110000" & o_city_id & formatn(rs.Fields(0).value, 8)
        Debug.Print o_full_id
        frmSplash.lblStatus.Caption = "generating name: " & o_usr_shw_name & ", Number is " & i & "..."
        DoEvents
        
        'check whether the primary key is over there
        sql = "SELECT 1 from `org_details` where usr_id='" & o_full_id & "'"
        Debug.Print sql
        Call CloseRecordSet(rsInsert)
        OperateDatabase rsInsert, cn, sql
        While Not rsInsert.EOF
            bExist = True
            rsInsert.MoveNext
        Wend
        If Not bExist Then
        sql = "INSERT INTO `org_details`(usr_id, temp_userid, curr_addr, thirdpart_upload, recorder, usr_mails, usr_phone, usr_shw_name, city_id) VALUES ('" & o_full_id & "', '" & rs.Fields(0).value & "',  '" & AddSlashes(o_curr_addr) & "', 1, 1, '" & o_usr_mails & "', '" & o_usr_phone & "', '" & AddSlashes(o_usr_shw_name) & "', '" & o_city_id & "' )"
        Else
        sql = "update `org_details` set temp_userid='" & rs.Fields(0).value & "', curr_addr='" & AddSlashes(o_curr_addr) & "', usr_mails='" & o_usr_mails & "', usr_phone='" & o_usr_phone & "', usr_shw_name='" & AddSlashes(o_usr_shw_name) & "', city_id=" & o_city_id & " WHERE usr_id = '" & o_full_id & "'"
        End If
        Debug.Print sql
        Call CloseRecordSet(rsInsert)
        OperateDatabase rsInsert, cn, sql
        rs.MoveNext
    Wend
AnotherCheck:
    sql = "SELECT * FROM `org_details` WHERE temp_userid not in (SELECT temp_userid FROM `org_firststep`) "
    Call CloseRecordSet(rs)
    OperateDatabase rs, cn, sql
    i = 0
    While Not rs.EOF
        i = i + 1
        o_tmp_userid = rs.Fields(1).value
        o_usr_shw_name = AddSlashes(rs.Fields(15).value)
        o_usr_mails = rs.Fields(11).value
        o_usr_phone = rs.Fields(12).value
        o_city_id = rs.Fields(23).value
        o_curr_addr = AddSlashes(rs.Fields(2).value)
        frmSplash.lblStatus.Caption = "Generating firststep table, name is " & o_usr_shw_name & " ..."
        DoEvents
        sql = "INSERT INTO `org_firststep` SET `temp_userid` = '" & o_tmp_userid & "', `org_name`='" & o_usr_shw_name & "', `emailadd` = '" & o_usr_mails & "', `tel` = '" & o_usr_phone & "', `org_type`=1, `user_pswd`='e10adc3949ba59abbe56e057f20f883e', `city_id` = '" & o_city_id & "', `curr_add`='" & o_curr_addr & "', `acc_status`=1"
        Debug.Print sql
        Call CloseRecordSet(rsInsert)
        OperateDatabase rsInsert, cn, sql
        rs.MoveNext
    Wend
    
    Unload frmSplash
    cn.Close
End Sub

Private Sub MDIForm_Activate()
    If Operator = "" Then
        Oversea.Caption = "Oversea Management welcomes : Chair Mao! "
    Else
        Oversea.Caption = "Oversea Management welcomes : " & Operator
    End If
    
    'Show some messages
    If Operator_ACC <= 10 Then
    frmMsg.Show
    End If
End Sub

Private Sub MDIForm_Load()
    Dim VN As String
    'Added on 25/4/2012
    'Priviage management, show menus to special login users
    '
    If Operator_ACC = 100 Then
        Data.Visible = False
        cs_hr.Visible = False
        cs_finance.Visible = False
        cs_marketing.Visible = False
        M.Visible = False
        cs_find.Visible = False
        cs_add.Visible = False
        cs_complaint.Visible = False
        cs_report.Visible = False
        OH.Visible = False
        
    ElseIf Int(Operator_ACC) > 10 Then
        If Int(Operator_ACC) <> 66 Then
            cs.Visible = False
        End If
        
        Data.Visible = False
        cs_hr.Visible = False
        cs_finance.Visible = False
        cs_marketing.Visible = False
    
    Else
    
    bCompulsive = False
    'before it was loaded, check we got new version in the database
    Call Cn2SQL(MDICn)
    
    If UpdateVer() Then
        VN = "Oversea-" & CheckVer() & ".rar"
        If bCompulsive Then
            MsgBox "You must update the software, otherwise it may cause fatel problems!", vbOKOnly, SOFT_TITLE
            DownloadAtt VN
            End
        Else
            If vbOK = MsgBox("Please update the software!", vbOKCancel, SOFT_TITLE) Then
                DownloadAtt VN
                End
            End If
        End If
    End If
    End If
End Sub

Private Sub DownloadAtt(ByVal FileName As String)
    ShellExecute Me.hwnd, "open", "http://www.compass-uat.com/CSTools/" & FileName, vbNullString, vbNullString, conSwNormal
End Sub

Private Sub MDIForm_Unload(Cancel As Integer)
      Unload frmLogin
      If val(Operator_ACC) <= 10 Then
        MDICn.Close
      End If
End Sub


Private Sub Newsmanager_Click()
    frmNews.Show
End Sub

Private Sub newversion_Click()
    'get the latest version
    Dim LVer As Long
    LVer = CheckVer()
    If LVer = 0 Then
        MsgBox "No version history in database!", vbOKOnly, SOFT_TITLE
    Else
        MsgBox "The latest version number: " & LVer, vbOKOnly, SOFT_TITLE
    End If
End Sub
Private Sub CloseRecordSet(ByRef rs As ADODB.Recordset)
On Error GoTo NoErr
        rs.Close
NoErr:
End Sub
Private Function CheckVer() As Long
    Dim sql As String
    CheckVer = 0
    sql = "select MAX(VerNumber) from `fota`"
    Call CloseRecordSet(MDIRs)
    OperateDatabase MDIRs, MDICn, sql
    
    If Not MDIRs.EOF Then
        MDIRs.MoveFirst
        CheckVer = val(MDIRs.Fields(0).value)
        
        'If val(MDIRs.Fields(1).value) = 1 Then
            bCompulsive = True
        'End If
    End If
    
End Function

Private Function UpdateVer() As Boolean
    Dim VN, Cv As Long
    
    VN = val(App.Major & App.Minor & App.Revision)
    Cv = val(CheckVer())
    If Cv > VN Then
        UpdateVer = True
    Else
        UpdateVer = False
    End If
    
End Function

Private Sub OH_Click()
    frmSplash.Show
    DoEvents
    History.Show
    DoEvents
    Unload frmSplash
End Sub

Private Sub ReadExcel_Click()
    'read data from excel table
    frmSplash.Show
    DoEvents
    frmAddFromCSV.Show
    DoEvents
    Unload frmSplash
End Sub

Private Sub ReplaceFlag_Click()
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim rs2 As New ADODB.Recordset
    Dim sql As String
    
    sql = "SELECT usr_shw_name, temp_userid FROM org_details order by temp_userid DESC limit 0, 500"
    Call Cn2Oversea(cn)
    Call CloseRecordSet(rs)
    OperateDatabase rs, cn, sql
    
    While Not rs.EOF
        Dim name As String
        name = rs.Fields(0).value
        name = Replace(name, "<", "(")
        name = Replace(name, ">", ")")
        
        sql = "UPDATE org_details SET usr_shw_name='" & AddSlashes(name) & "' WHERE temp_userid='" & rs.Fields(1).value & "'"
        Call CloseRecordSet(rs2)
        OperateDatabase rs2, cn, sql
        
        rs.MoveNext
    Wend
    
    sql = "SELECT org_name, temp_userid FROM org_firststep order by temp_userid DESC limit 0, 500"
    Call CloseRecordSet(rs)
    OperateDatabase rs, cn, sql
    
    While Not rs.EOF
        name = rs.Fields(0).value
        name = Replace(name, "<", "(")
        name = Replace(name, ">", ")")
        
        sql = "UPDATE org_firststep SET org_name='" & AddSlashes(name) & "' WHERE temp_userid='" & rs.Fields(1).value & "'"
        Call CloseRecordSet(rs2)
        OperateDatabase rs2, cn, sql
        rs.MoveNext
    Wend
    
    cn.Close
End Sub

Private Sub RunSQL_Click()
    frmRunSQL.Show
End Sub

Private Sub SeekID_Click()
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim rsSub As New ADODB.Recordset
    
    Dim sql, InputName, Result As String
    
    InputName = InputBox("Please input the name of classification:", SOFT_TITLE)
    If InputName = "" Then
        Exit Sub
    End If
    
    sql = "SELECT `Sort_ID` FROM `cs_sort` WHERE `Sort_Name` = '" & Trim(InputName) & "'"
    Call Cn2Oversea(cn)
    Call CloseRecordSet(rs)
    OperateDatabase rs, cn, sql
    
    Result = ""
    
    While Not rs.EOF
        Dim SortId As Long
        
        SortId = rs.Fields(0).value
        If Len(CStr(SortId)) = 4 Then
                sql = "SELECT `Sort_Name` FROM `cs_sort` WHERE `Sort_ID` = '" & val(Mid(CStr(SortId), 1, 1)) & "'"
        Else
                sql = "SELECT `Sort_Name` FROM `cs_sort` WHERE `Sort_ID` = '" & val(Mid(CStr(SortId), 1, 2)) & "'"
        End If
        Call CloseRecordSet(rsSub)
        OperateDatabase rsSub, cn, sql
        
        Result = Result & rsSub.Fields(0).value & " -> " & SortId & vbCrLf
        rs.MoveNext
    Wend
    If Result <> "" Then
        MsgBox Result, vbOKOnly, SOFT_TITLE
    Else
        MsgBox "No result, check your input!", vbOKOnly, SOFT_TITLE
    End If
    cn.Close
End Sub

Private Sub showstatus_Click()
   frmStatus.Show
End Sub

Private Sub SiteMap_Click()
    Dim MDISiteCn As New ADODB.Connection
    frmSplash.Show
    DoEvents
       Call Cn2Oversea(MDISiteCn)
       frmSplash.lblStatus.Caption = "Generating....."
       GenerateMapSite MDISiteCn
       MDISiteCn.Close
    DoEvents
    Unload frmSplash
    MsgBox "All done!", vbOKOnly, SOFT_TITLE
End Sub

Private Sub GenerateMapSite(MDISiteCn As ADODB.Connection)
    Dim sql As String
    Dim FileName As String
    Dim sXML As String
    Dim txtfile
    Dim fso As New Scripting.FileSystemObject
    
    '<?xml version="1.0/" encoding=/"UTF-8/"?>" & vbcrlf & "<urlset xmlns="http://www.sitemaps.org/schemas/sitemap/0.9">"
    
    sql = "select temp_userid from org_firststep where acc_status<>10 and `city_id`=8 limit 0, 50000"
    Call CloseRecordSet(MDIRs)
    OperateDatabase MDIRs, MDISiteCn, sql
    FileName = "sitemap.xml"
    Set txtfile = fso.CreateTextFile(FileName, True)
'format
'<url>
'<loc>Http://www.oversea.com.au/viewinfo-22.html</loc>
'<lastmod>2012-02-09</lastmod>
'<changefreq>always</changefreq>
'<priority>1.0</priority>
'</url>
    While Not MDIRs.EOF
        frmSplash.lblStatus.Caption = "Generating ID is " & MDIRs.Fields(0).value & "....."
        DoEvents
        sXML = "<url>" & vbCrLf & "<loc>http://www.oversea.com.au/viewinfo/" & MDIRs.Fields(0).value & "/</loc>" & vbCrLf
        sXML = sXML & "<lastmod>2012-02-09</lastmod>" & vbCrLf
        sXML = sXML & "<changefreq>always</changefreq>" & vbCrLf & "<priority>1.0</priority>" & vbCrLf & "</url>"
        txtfile.WriteLine (sXML)
        MDIRs.MoveNext
    Wend
'should add </urlset>
    txtfile.Close
End Sub


Private Sub version_Click()
    MsgBox "Current version number: " & App.Major & App.Minor & App.Revision, vbOKOnly, SOFT_TITLE
End Sub

Private Sub WebGuide_Click()
    frmSplash.Show
    DoEvents
    frmWebGuide.Show
    DoEvents
    Unload frmSplash
End Sub

Private Sub webGuideCollection_Click()
    'download 1 million website urls including keywords and description
    frmAlphaWebsiteGuide.Show
End Sub

Private Sub WebSpider_Click()
    'this is a spider will get title, description and keywords from all web pages
    
End Sub

Private Sub WS_Click()
    frmWorkingSheet.Show
End Sub
